library(rJava)
library(qCBA)
library(arc)
.jinit()
[1] 0
data <- read.csv("../data/breast-w0.csv")
data[1:5,]
smp_size <- floor(1 * nrow(data))
set.seed(123)
train_ind <- sample(seq_len(nrow(data)), size = smp_size)
train <- data[train_ind, ]
test <- data[train_ind, ]
rmCBA <- cba(train, classAtt=colnames(data)[length(colnames(data))])
Using automatic threshold detection
Running apriori with setting: confidence = 0.5 , support = 0 , minlen = 2 , maxlen = 3 , MAX_RULE_LEN = 10
Rule count: 483 Iteration: 1
Increasing maxlen to: 4
Running apriori with setting: confidence = 0.5 , support = 0 , minlen = 2 , maxlen = 4 , MAX_RULE_LEN = 10
Rule count: 5493 Iteration: 2
Target rule count satisfied: 1000
Removing excess discovered rules
Rule learning took: 0.15 seconds
Original rules: 1000
Rules after data coverage pruning: 47
Performing default rule pruning.
Final rule list size: 42
Pruning took: 0.83 seconds
inspect(rmCBA@rules[1:5])
lhs rhs support confidence lift count lhs_length
[1] {Cell_Size_Uniformity=-inf_to_1.5,
Normal_Nucleoli=-inf_to_2.5} => {Class=benign} 0.5350318 1 1.524272 336 2
[2] {Bare_Nuclei=-inf_to_1.5,
Single_Epi_Cell_Size=-inf_to_2.5} => {Class=benign} 0.5159236 1 1.524272 324 2
[3] {Cell_Shape_Uniformity=-inf_to_1.5,
Normal_Nucleoli=-inf_to_2.5} => {Class=benign} 0.4920382 1 1.524272 309 2
[4] {Cell_Size_Uniformity=-inf_to_1.5,
Bare_Nuclei=-inf_to_1.5} => {Class=benign} 0.4856688 1 1.524272 305 2
[5] {Marginal_Adhesion=-inf_to_1.5,
Clump_Thickness=-inf_to_4.5} => {Class=benign} 0.4347134 1 1.524272 273 2
itemMatrixRules <- as.item.matrix(rmqCBA, train)
inspect(itemMatrixRules[1:5,])
lhs rhs support confidence lift count lhs_length
[1] {Cell_Size_Uniformity=-inf_to_1.5,
Normal_Nucleoli=-inf_to_2.5} => {Class=benign} 0.5350319 1 1.524272 336 2
[2] {Bare_Nuclei=-inf_to_1.5,
Single_Epi_Cell_Size=-inf_to_2.5} => {Class=benign} 0.5159236 1 1.524272 323 2
[3] {Cell_Shape_Uniformity=-inf_to_1.5,
Normal_Nucleoli=-inf_to_2.5} => {Class=benign} 0.4920382 1 1.524272 309 2
[4] {Bare_Nuclei=-inf_to_1.5,
Cell_Size_Uniformity=-inf_to_1.5} => {Class=benign} 0.4856688 1 1.524272 304 2
[5] {Clump_Thickness=-inf_to_4.5,
Marginal_Adhesion=-inf_to_1.5} => {Class=benign} 0.4347134 1 1.524272 272 2
qcbaRules <- as.qcba.rules(itemMatrixRules)
qcbaRules[1:10,]
Overwriting the QCBA object slot with the new rules and converting back to arules itemMatrix.
rmqCBA@rules <- qcbaRules
itemMatrixRules2 <- as.item.matrix(rmqCBA, train)
inspect(itemMatrixRules2[1:10])
lhs rhs support confidence lift count lhs_length
[1] {Cell_Size_Uniformity=-inf_to_1.5,
Normal_Nucleoli=-inf_to_2.5} => {Class=benign} 0.53503186 1 1.524272 336 2
[2] {Bare_Nuclei=-inf_to_1.5,
Single_Epi_Cell_Size=-inf_to_2.5} => {Class=benign} 0.51592356 1 1.524272 323 2
[3] {Cell_Shape_Uniformity=-inf_to_1.5,
Normal_Nucleoli=-inf_to_2.5} => {Class=benign} 0.49203822 1 1.524272 309 2
[4] {Bare_Nuclei=-inf_to_1.5,
Cell_Size_Uniformity=-inf_to_1.5} => {Class=benign} 0.48566878 1 1.524272 304 2
[5] {Clump_Thickness=-inf_to_4.5,
Marginal_Adhesion=-inf_to_1.5} => {Class=benign} 0.43471336 1 1.524272 272 2
[6] {Cell_Shape_Uniformity=-inf_to_1.5,
Clump_Thickness=-inf_to_4.5} => {Class=benign} 0.41401273 1 1.524272 259 2
[7] {Bland_Chromatin=-inf_to_2.5,
Cell_Size_Uniformity=-inf_to_1.5} => {Class=benign} 0.38216561 1 1.524272 240 2
[8] {Bland_Chromatin=2.5_to_3.5,
Cell_Size_Uniformity=-inf_to_1.5} => {Class=benign} 0.15764332 1 1.524272 99 2
[9] {Bland_Chromatin=-inf_to_2.5,
Clump_Thickness=4.5_to_6.5} => {Class=benign} 0.09235669 1 1.524272 58 2
[10] {Bare_Nuclei=-inf_to_1.5,
Cell_Shape_Uniformity=1.5_to_2.5} => {Class=benign} 0.05891720 1 1.524272 37 2
plotly_arules(itemMatrixRules)
'plotly_arules' is deprecated.
Use 'plot' instead.
See help("Deprecated")
inspectDT(itemMatrixRules2)
cbaFiringRuleIDs <- explainPrediction.CBARuleModel(rmCBA, train)
dimnames(.) <- NULL: translated to
dimnames(.) <- list(NULL,NULL) <==> unname(.)
cbaFiringRules <- as.qcba.rules(rmCBA@rules)[cbaFiringRuleIDs,]
# explanation demo
firingRuleIDs <- predict(rmqCBA,test,outputFiringRuleIDs=TRUE)
firingRules <- rmqCBA@rules[firingRuleIDs,]
ir <- new("intervalReader",
numberSeparator = "_to_",
negativeInfinity = "-inf",
positiveInfinity = "inf",
leftClosedBracket = "<",
leftOpenBracket = "",
rightClosedBracket = "",
rightOpenBracket = ")",
bracketLen = 0)
explanation_dataframe <- getExplanationsDataframe(rmqCBA@rules, firingRuleIDs, train, includeJustifications = TRUE, ir)
explanation_dataframe
explanation_dataframe <- getClassExplanationsDataframe(rmqCBA, data, ir)
explanation_dataframe
$benign
$malignant
NA
cba_explanation_dataframe <- getExplanationsDataframe(as.qcba.rules(rmCBA@rules), cbaFiringRuleIDs, train, includeJustifications = TRUE, ir)
cba_explanation_dataframe
cba_explanation_dataframe <- getClassExplanationsDataframe(rmCBA, train, ir)
cba_explanation_dataframe[["benign"]]